Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/apptbk/apptbook.txt

Text File | 1993-01-06 | 20KB | 696 lines

' Variables used to manage grid

Dim IgnoreRowChange As Integer
Dim GridInvertRect As RECT
Dim GridInverted As Integer
Dim GridDropRow As Integer

' Drag mode constants to keep track of dragging activity.

Dim DragType As Integer         ' type of object being dragged
Dim Dragging As Integer         ' TRUE when dragging is in progress
Dim DragIndex As Integer        ' Optional index of dragged obj
Dim DragRow As Integer          ' Optional row being dragged in grid

' Miscellaneous variables

Dim valid%                      ' used as return for DragValid

' Bitmasks to describe valid drag objects

Const MASK_NEWAPPT = 1      ' a new appointment
Const MASK_OLDAPPT = 2      ' an old appointment
Const MASK_NONE = 0         ' mask used where no drops are allowed

Function ApiRectFromPoint (ctl As Grid, X As Single, Y As Single, r As RECT) As Integer

    ' Given a grid control and a coordinate position, this routine
    ' returns a Windows RECT structure containing the pixel
    ' coordinates of the row being pointed at.  The row number is
    ' returned, or -1, indicating that no row is being pointed at.

    Dim curRow As Integer
    Dim totHeight As Single
    Dim topLocation As Single

    ' Loop through each row, accumulating row height until we reach
    ' the row containing the point.

    For curRow = 0 To ctl.Rows - 1

        topLocation = totHeight
        totHeight = totHeight + ctl.RowHeight(curRow) + Screen.TwipsPerPixelY

        If Y < totHeight Then

            ' Convert the twips values into pixel coordinates

            ApiRectFromPoint = curRow

            r.top = topLocation / Screen.TwipsPerPixelY
            r.bottom = totHeight / Screen.TwipsPerPixelY
            r.left = 0
            r.right = ctl.Width / Screen.TwipsPerPixelY

            Exit Function

        End If

    Next curRow

    ApiRectFromPoint = -1           ' indicate failure

End Function

Sub ApptEdit ()

    ' This subroutine moves the data in the current grid row into
    ' the "post-it" editing area.

    Dim aText As String
    Dim colonPos As Integer

    ' This routine copies appointment data to the edit window

    ApptList.Col = 1

    aText = ApptList.Text
    colonPos = InStr(aText, ":")

    ' If no colon, there's no appointment, so clear the post-it
    ' area.  If there is a colon, fill in the information.

    If colonPos = 0 Then
        ApptText.Text = ""
        ApptTime.Text = Format$(0, ApptTime.Format)
        ApptType.Text = ""
    Else
        ApptType.Text = Left$(aText, colonPos - 1)
        ApptText.Text = Mid$(aText, colonPos + 2)
        ApptList.Col = 0
        ApptTime.Text = Format$(ApptList.Text, ApptTime.Format)
    End If

End Sub

Sub ApptList_DragDrop (Source As Control, X As Single, Y As Single)

    ' Drop a new appointment or existing appointment at a new
    ' row position.

    Dim aText As String
    Dim i%

    If Not EndDragMode(MASK_NEWAPPT Or MASK_OLDAPPT) Then Exit Sub

    UnhighlightRow
    IgnoreRowChange = True

    If DragType = MASK_NEWAPPT Then
        ApptList.Col = 1
        ApptList.Row = GridDropRow
        ApptList.Text = Source.Tag & ": "
        ApptEdit
    Else
        ApptList.Col = 0
        ApptList.Row = GridDropRow
        aText = ApptList.Text
        ApptList.Row = DragRow
        i% = ChangeApptTime(TimeValue(aText))
    End If

    IgnoreRowChange = False
    ApptText.SetFocus

End Sub

Sub ApptList_DragOver (Source As Control, X As Single, Y As Single, State As Integer)

    ' When dragging over the grid, both new and old appointments
    ' are considered.  For both cases, we unhighlight the current
    ' destination row upon leaving the drop zone, and assure that
    ' the row under the point is highlighted otherwise.

    If Not DragValid(Source, MASK_NEWAPPT Or MASK_OLDAPPT, State) Then
        Exit Sub
    End If

    Select Case State
        Case LEAVE
            UnhighlightRow
        Case Else
            GridDropRow = HighlightRowAtPoint(X, Y)
    End Select

End Sub

Sub ApptList_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' We take charge of the mouse down event to initiate dragging
    ' ourselves.  First, the cursor must be in column 1.  Next,
    ' the row must contain a valid appointment to be grabbed
    ' (identified by the presence of a colon in the cell).

    If AtGridCol(ApptList, X, Y) > 0 Then
        If InStr(ApptList.Text, ":") <> 0 Then

            ' The timer will now count down.  This allows the user
            ' to easily click, or "press" the mouse.  The Timer
            ' event handles the drag initialization.

            GridTimer.Enabled = True

        End If
    End If

End Sub

Sub ApptList_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' Be sure the timer is disabled so that a click doesn't
    ' initiate a drag.  If it's already disabled, it doesn't matter.

    GridTimer.Enabled = False

End Sub

Sub ApptList_RowColChange ()

    ' Whenever the row changes, move the highlight to track the
    ' current cell.

    ApptList.SelStartRow = ApptList.Row
    ApptList.SelEndRow = ApptList.Row

    ' IgnoreRowChange means that we're setting Col or Row somewhere
    ' else in the code and we don't want ApptEdit to be called.
    ' Otherwise, the user changed the row and we update the
    ' "post-it" area.

    If Not IgnoreRowChange Then
        IgnoreRowChange = True
        ApptEdit
        IgnoreRowChange = False
    End If

End Sub

Sub ApptText_DragDrop (Source As Control, X As Single, Y As Single)
    valid% = EndDragMode(MASK_NONE)
End Sub

Sub ApptText_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    valid% = DragValid(Source, MASK_NONE, State)
End Sub

Sub ApptTime_DragDrop (Source As Control, X As Single, Y As Single)
    valid% = EndDragMode(MASK_NONE)
End Sub

Sub ApptTime_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    valid% = DragValid(Source, MASK_NONE, State)
End Sub

Sub ApptTime_ValidationError (InvalidText As String, StartPosition As Integer)

    MsgBox "Invalid time"
    ApptTime.SetFocus

End Sub

Sub ApptType_DragDrop (Source As Control, X As Single, Y As Single)

    ' Accept a drop only for a NEWAPPT icon, otherwise the
    ' operation will be cancelled.

    If EndDragMode(MASK_NEWAPPT) Then
        ApptType.Text = Source.Tag
    End If

End Sub

Sub ApptType_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    valid% = DragValid(Source, MASK_NEWAPPT, State)
End Sub

Sub ApptType_KeyPress (KeyAscii As Integer)

    ' Don't allow a colon to be entered, since we use a colon to
    ' separate the appointment "kind" from the text.

    If KeyAscii = Asc(":") Then
        Beep
        KeyAscii = 0
    End If

End Sub

Function AtGridCol (ctl As Control, X As Single, Y As Single)

    ' Given a point on a grid control, in twips, this routine
    ' returns the column number where the point is located, or
    ' -1 indicating the point is outside the grid.

    Dim curCol As Integer
    Dim totWidth As Single

    ' Loop through each column, accumulating column width until we
    ' reach the column containing the point.

    For curCol = 0 To ctl.Cols - 1

        totWidth = totWidth + ctl.ColWidth(curCol) + Screen.TwipsPerPixelX

        If X < totWidth Then
            AtGridCol = curCol
            Exit Function
        End If

    Next curCol

    AtGridCol = -1          ' not found

End Function

Sub BeginDragMode (ctl As Control, objType As Integer)

    ' Whenever a drag is about to start, this routine is called.
    ' The type mask of the drag is flagged, and we remember that
    ' dragging is in progress.   This routine MUST be matched
    ' by an EndDragMode function call.

    DragType = objType
    Dragging = True

    ' S